home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / adpipeax / drag.frm (.txt) < prev    next >
Visual Basic Form  |  1997-01-07  |  5KB  |  147 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDrag 
  3.    Caption         =   "Drag and Drop"
  4.    ClientHeight    =   2670
  5.    ClientLeft      =   2130
  6.    ClientTop       =   2865
  7.    ClientWidth     =   6405
  8.    ClipControls    =   0   'False
  9.    BeginProperty Font 
  10.       Name            =   "MS Sans Serif"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   700
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    LinkTopic       =   "Form2"
  19.    MDIChild        =   -1  'True
  20.    PaletteMode     =   1  'UseZOrder
  21.    ScaleHeight     =   2670
  22.    ScaleWidth      =   6405
  23.    Begin VB.DriveListBox Drive1 
  24.       DragIcon        =   "DRAG.frx":0000
  25.       Height          =   315
  26.       Left            =   120
  27.       TabIndex        =   2
  28.       Top             =   120
  29.       Width           =   1935
  30.    End
  31.    Begin VB.FileListBox File1 
  32.       BeginProperty Font 
  33.          Name            =   "System"
  34.          Size            =   9.75
  35.          Charset         =   0
  36.          Weight          =   700
  37.          Underline       =   0   'False
  38.          Italic          =   0   'False
  39.          Strikethrough   =   0   'False
  40.       EndProperty
  41.       Height          =   2010
  42.       Left            =   2280
  43.       Pattern         =   "*.txt;*.bmp;*.exe;*.hlp"
  44.       TabIndex        =   1
  45.       Top             =   120
  46.       Width           =   2052
  47.    End
  48.    Begin VB.DirListBox Dir1 
  49.       DragIcon        =   "DRAG.frx":030A
  50.       BeginProperty Font 
  51.          Name            =   "System"
  52.          Size            =   9.75
  53.          Charset         =   0
  54.          Weight          =   700
  55.          Underline       =   0   'False
  56.          Italic          =   0   'False
  57.          Strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   1920
  60.       Left            =   120
  61.       TabIndex        =   0
  62.       Top             =   600
  63.       Width           =   1935
  64.    End
  65.    Begin VB.Image Image1 
  66.       BorderStyle     =   1  'Fixed Single
  67.       Height          =   2415
  68.       Left            =   4560
  69.       Stretch         =   -1  'True
  70.       Top             =   120
  71.       Width           =   1725
  72.    End
  73. Attribute VB_Name = "frmDrag"
  74. Attribute VB_GlobalNameSpace = False
  75. Attribute VB_Creatable = False
  76. Attribute VB_PredeclaredId = True
  77. Attribute VB_Exposed = False
  78. Private Sub Dir1_Change()
  79.     File1.Path = Dir1.Path
  80. End Sub
  81. Private Sub Drive1_Change()
  82.     On Error GoTo DriveErrs
  83.         Dir1.Path = Drive1.Drive
  84.         Exit Sub
  85.         
  86. DriveErrs:
  87.     Select Case Err
  88.         Case 68
  89.             MsgBox prompt:="Drive not ready. Please insert disk in drive.", _
  90.             buttons:=vbExclamation
  91.             ' Reset path to previous drive.
  92.             Drive1.Drive = Dir1.Path
  93.             Exit Sub
  94.         Case Else
  95.             MsgBox prompt:="Application error.", buttons:=vbExclamation
  96.     End Select
  97. End Sub
  98. Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  99.     File1.DragIcon = Drive1.DragIcon
  100.     File1.Drag
  101. End Sub
  102. Private Sub Form_Load()
  103.     frmDrag.Width = 6525
  104.     frmDrag.Height = 3075
  105. End Sub
  106. Private Sub Image1_DragDrop(Source As Control, X As Single, Y As Single)
  107.     ' Get the last three letters of the dragged filename.
  108.     temp = Right$(File1.filename, 3)
  109.     ' If dragged file is in the root, append filename.
  110.     If Mid$(File1.Path, Len(File1.Path)) = "\" Then
  111.       dropfile = File1.Path & File1.filename
  112.     ' If dragged file is not in root, append "\" and filename.
  113.     Else
  114.       dropfile = File1.Path & "\" & File1.filename
  115.     End If
  116.       
  117.     Image1.Picture = LoadPicture("")
  118.     Select Case UCase$(Trim$(temp))
  119.         Case "TXT"
  120.             X = Shell("Notepad " + dropfile, 1)
  121.         Case "BMP"
  122.             Image1.Picture = LoadPicture(dropfile)
  123.         Case "EXE"
  124.             X = Shell(dropfile, 1)
  125.         Case "HLP"
  126.             X = Shell("WinHelp " + dropfile, 1)
  127.         Case Else
  128.             msg = "Try one of these file types:"
  129.             msg = vbCrLf & msg & vbCrLf & vbCrLf & "     .txt, .bmp, .exe, .hlp"
  130.             MsgBox msg
  131.     End Select
  132. End Sub
  133. Private Sub Image1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
  134.     Select Case State
  135.     Case 0
  136.         ' Display a new icon when the source enters the drop area.
  137.         File1.DragIcon = Dir1.DragIcon
  138.     Case 1
  139.         ' Display the original DragIcon when the source leaves the drop area.
  140.         File1.DragIcon = Drive1.DragIcon
  141.     End Select
  142. ' Note that Dir1.DragIcon and Drive1.DragIcon have been
  143. ' set at design time. This allows you to load the "Enter"
  144. ' and "Leave" icons for File1 at run time without requiring
  145. ' that the user has those icons on disk.
  146. End Sub
  147.